home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #23 (Aug 87) / Basic font menus source / ZResources.BAS < prev   
BASIC Source File  |  1987-06-19  |  4KB  |  201 lines
  1. REM ZBASIC RESOURCE EXAMPLE
  2. REM ©MacTutor 1987
  3. REM By Dave Kelly
  4. REM IMPORTANT: COMPILE THIS PROGRAM AS
  5. REM AN APPLICATION BEFORE RUNNING!!
  6. REM Resources are used which need to be
  7. REM written to application's own resource file
  8.  
  9. WINDOW OFF:REM Turn off default window
  10. BREAK ON : REM This line may be deleted after program is debugged.
  11. DEFSTR LONG:DEF MOUSE=-1:COORDINATE WINDOW
  12.  
  13. REM Routine to convert string resource to a string, given the handle.
  14. LONG FN ReturnString$(SHndl&)
  15. FByte%=PEEK(PEEK LONG(SHndl&))
  16. String$=""
  17. FOR i%=1 TO FByte%
  18.     String$=String$+CHR$(PEEK(PEEK LONG(SHndl&)+i%))
  19. NEXT i%
  20. END FN= String$
  21.  
  22. WINDOW #1,"",(50,100)-(450,300),4 : REM Main window.
  23. False=0:True=NOT(False)
  24. OldFont=0:OldSize=12
  25. REM Setup menus
  26. APPLE MENU "About this application…"
  27. MENU 1,0,1,"File"
  28. MENU 1,1,1,"Quit"
  29. EDIT MENU 2
  30. MENU 3,0,1,"Font"
  31. MENU 4,0,1,"Size"
  32. MENU 4,1,1,"9 Point"
  33. MENU 4,2,1,"10 Point"
  34. MENU 4,3,1,"12 Point"
  35. MENU 4,4,1,"14 Point"
  36. MENU 4,5,1,"18 Point"
  37. MENU 4,6,1,"24 Point"
  38. SizeMenuHandle&=FN GETMHANDLE(4)
  39. FontMenuHandle&=FN GETMHANDLE(3)
  40. CALL ADDRESMENU(FontMenuHandle&,CVI("FONT"))
  41.  
  42. REM Find out what this application is named…
  43. CurApName=&H910
  44. CurApName$=""
  45. FOR I=1 TO PEEK(CurApName)
  46.     CurApName$=CurApName$+CHR$(PEEK(CurApName+I))
  47. NEXT I
  48.  
  49. REM Open application resource file
  50. Refnum=FN OPENRESFILE(CurApName$)
  51. Errnum=FN RESERROR
  52. LONG IF Errnum<>0 
  53. BEEP
  54. PRINT "ERROR # ";Errnum
  55. PRINT"Problem with Application Resource File!"
  56. FOR I=1 TO 1000:NEXT I:END
  57. END IF
  58. StrHnd&=FN GETRESOURCE(CVI("STR "),1000)
  59.  
  60. REM Setting up string resource to save default font and size
  61. LONG IF StrHnd&=0
  62. Str$="Chicago.12"
  63. StrHnd&=FN NEWSTRING(Str$)
  64. CALL ADDRESOURCE(StrHnd&,CVI("STR "),1000,"")
  65. XELSE
  66. StrHnd&=FN GETSTRING(1000)
  67. END IF
  68.  
  69. REM Convert default font and size
  70. default$=FN ReturnString$(StrHnd&)
  71. defaultfont$=MID$(default$,1,INSTR(1,default$,".")-1)
  72. Fsize=VAL(MID$(default$,INSTR(1,default$,".")+1))
  73.  
  74. REM Check default font in Font menu
  75. fontcnt%=FN COUNTMITEMS(FontMenuHandle&)
  76. FOR i=1 TO fontcnt%
  77.     CALL GETITEM(FontMenuHandle&,i,item$)
  78.     IF item$=defaultfont$ THEN OldFont=i:i=fontcnt%+1
  79. NEXT i
  80. CALL CHECKITEM(FontMenuHandle&,OldFont,True)
  81.  
  82. REM Check default size in Size menu
  83. sizecnt%=FN COUNTMITEMS(FontMenuHandle&)
  84. FOR i=1 TO sizecnt%
  85.     CALL GETITEM(SizeMenuHandle&,i,item$)
  86.     sname$=MID$(STR$(Fsize),2)+" Point"
  87.     IF item$=sname$ THEN OldSize=i:i=sizecnt%+1
  88. NEXT i
  89. CALL CHECKITEM(SizeMenuHandle&,OldSize,True)
  90.  
  91. CALL GETFNUM(defaultfont$,Fnum%)
  92. TEXT Fnum%,Fsize,0,0
  93. GOSUB "Display"
  94. ON MENU GOSUB "MenuEvent"
  95. FLUSHEVENTS:MENU ON
  96.  
  97. REM Loop here until something happens
  98. "Loop"
  99. DO
  100. UNTIL 0
  101. MENU STOP
  102. END
  103.  
  104. "MenuEvent"
  105. Menunumber=MENU(0):Menuitem=MENU(1)
  106. MENU
  107. SELECT Menunumber
  108.     CASE 1
  109.         GOSUB "File"
  110.     CASE 2
  111.         GOSUB "Edit"
  112.     CASE 3
  113.         GOSUB"Font"
  114.     CASE 4
  115.         GOSUB"Size"
  116.     CASE 255
  117.         IF Menuitem=1 THEN GOSUB "About"
  118.         GOSUB "Display"
  119.     CASE ELSE
  120. END SELECT
  121. RETURN
  122.  
  123. "About" :REM About menu
  124. WINDOW #2,"",(75,100)-(400,250),-2
  125. TEXT 2,14,1,0
  126. PRINT
  127. PRINT SPACE$(11);"ZBasic™ Resource Sample"
  128. PRINT
  129. TEXT 2,12,0,0
  130. PRINT SPACE$(15);"©MacTutor, 1987 by Dave Kelly"
  131. PRINT
  132. PRINT SPACE$(12);"ZBasic™ Version 4.0 -  IT WORKS!!!!"
  133. PRINT
  134. MOUSE ON
  135. DO
  136. UNTIL MOUSE(0)<>0
  137. MOUSE OFF
  138. WINDOW CLOSE #2
  139. GOSUB "Display"
  140. RETURN
  141. "File"
  142. CALL UPDATERESFILE(RefNum)
  143. END
  144.  
  145. "Edit"  : REM Edit menu - used for DA's only
  146. RETURN
  147.  
  148. "Font"  : REM Font menu
  149. CALL CHECKITEM(FontMenuHandle&,OldFont,False)
  150. CALL GETITEM(FontMenuHandle&,Menuitem,FontName$)
  151. CALL CHECKITEM(FontMenuHandle&,Menuitem,True)
  152. CALL GETITEM(FontMenuHandle&,Menuitem,defaultfont$)
  153. CALL GETFNUM(defaultfont$,Fnum%)
  154. IF Menuitem<>OldFont GOSUB "SetResString"
  155. OldFont=Menuitem
  156. GOSUB "Display"
  157. RETURN
  158.  
  159. "Size" : REM Size menu
  160. CALL CHECKITEM(SizeMenuHandle&,OldSize,False)
  161. CALL CHECKITEM(SizeMenuHandle&,Menuitem,True)
  162. SELECT Menuitem
  163.     CASE 1
  164.         Fsize=9
  165.     CASE 2
  166.         Fsize=10
  167.     CASE 3
  168.         Fsize=12
  169.     CASE 4
  170.         Fsize=14
  171.     CASE 5
  172.         Fsize=18
  173.     CASE 6
  174.         Fsize=24
  175. END SELECT
  176. IF Menuitem<>OldSize GOSUB "SetResString"
  177. OldSize=Menuitem
  178. GOSUB "Display"
  179. RETURN
  180.  
  181. REM Set string to be saved in string resource
  182. "SetResString"
  183. default$=defaultfont$+"."+MID$(STR$(Fsize),2)
  184. CALL SETSTRING(StrHnd&,default$)
  185. CALL CHANGEDRESOURCE(StrHnd&)
  186. RETURN
  187.  
  188. "Display" :REM Main screen display
  189. TEXT Fnum%,Fsize,0,0
  190. CLS 
  191. PRINT "FONT:";defaultfont$
  192. PRINT "SIZE:";Fsize
  193. PRINT
  194. TEXT ,,1,0
  195. MacTutor$="Read MacTutor™ !!"
  196. REM Center MacTutor string
  197. Pxls%=FN STRINGWIDTH(MacTutor$)
  198. Windwidth%=WINDOW(6)
  199. CALL MOVE((Windwidth%-Pxls%)/2,0)
  200. PRINT MacTutor$
  201. RETURN